home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio / Ham Radio CD-ROM (Emerald Software) (1995).ISO / maps / gr8circl / gr8circl.bas
BASIC Source File  |  1991-09-26  |  7KB  |  226 lines
  1. 40 CLS
  2. 50 PRINT "GREAT CIRCLE BEARINGS AND DISTANCES PROGRAM"
  3. 52 REM
  4. 55 PRINT
  5. 60 PRINT "DO YOU NEED INSTRUCTIONS? YES OR NO"
  6. 65 INPUT I$
  7. 70 IF I$ = "NO" THEN 165
  8. 100 PRINT "THIS PROGRAM CALCULATES GREAT CIRCLE DISTANCES IN"
  9. 110 PRINT "STATUTE MILES AND KILOMETERS AND BEARINGS BETWEEN"
  10. 120 PRINT "YOU AND THE REST OF THE WORLD. LATITUDES IN THE"
  11. 130 PRINT "NORTHERN MEM ARE POSITIVE AND SOUTHERN HEM ARE NEG."
  12. 140 PRINT "LONGITUDES IN THE EASTERN HEM ARE POSITIVE"
  13. 150 PRINT "AND WESTERN HEM ARE NEGATIVE. ALWAYS USE DEGREES"
  14. 160 PRINT "WITH DECIMAL PARTS - NO MINUTES AND SECONDS"
  15. 165 PRINT
  16. 170 PRINT "WHAT IS YOUR NAME AND CALL LETTER?"
  17. 175 LINE INPUT N$
  18. 180 PRINT "WHAT IS YOUR LOCATION (HOME QTH)?"
  19. 185 LINE INPUT W$
  20. 190 PRINT "WHAT IS THE LATITUDE OF THIS LOCATION?"
  21. 195 INPUT A
  22. 200 REM  CONVERT A TO RADIANS
  23. 205 LET A1=A*3.1415926#/180
  24. 210 PRINT
  25. 220 PRINT "WHAT IS THE LONGITUDE OF THIS LOCATION?"
  26. 240 INPUT L1
  27. 250 LET J=0
  28. 252 LET F=0
  29. 255 GOSUB 2000
  30. 260 PRINT "SELECT THE FUNCTION YOU WANT AND ENTER THE NUMBER"
  31. 265 PRINT
  32. 270 PRINT "1 = GLOBAL GRID CENTERED ON YOUR LOCATION"
  33. 275 PRINT "    (LAT EVERY 15 DEGREES & LONG EVERY 30 DEGREES"
  34. 280 PRINT "2 = BEARINGS AND DISTANCES TO MAJOR US CITIES"
  35. 285 PRINT "3 = BEARINGS & DISTANCE TO DX LOCATIONS FROM THE"
  36. 290 PRINT "    ARRL COUNTRIES LIST - LISTED BY CALL PREFIX"
  37. 292 PRINT "4 = BOTH US CITIES AND DX LIST."
  38. 295 PRINT "5 = BEARINGS & DISTANCE TO USER SELECTED POINTS"
  39. 300 PRINT "6 = ENTER NEW CENTRAL LOCATION"
  40. 305 PRINT "7 = TERMINATE THE PROGRAM***"
  41. 307 PRINT
  42. 310 INPUT S
  43. 312 PRINT
  44. 315 ON S GOTO 400,515,605,510,700,50,9999
  45. 400 GOSUB 2000
  46. 401 PRINT "GREAT CIRCLE COORDINATES CENTERED ON";W$
  47. 405 PRINT
  48. 410 PRINT "PROGRAMMED FOR ";N$
  49. 430 PRINT
  50. 435 PRINT "LATITUDE LONGITUDE MILES KILOMETERS BEARING"
  51. 437 PRINT "-------------------------------------------"
  52. 440 FOR L2 = -180 TO 180 STEP 30
  53. 450 FOR B =  - 90 TO 90  STEP 30
  54. 460 GOSUB 1000
  55. 465 PRINT TAB3;B;TAB11;L2;TAB22;D1;TAB30;D2;TAB44;R2
  56. 468 REM CHECK THE LINE COUNTER
  57. 469 LET K = K+1
  58. 470 IF K=55 THEN 485
  59. 475 NEXT B
  60. 480 NEXT L2
  61. 482 GOTO 250
  62. 485 GOSUB 2000
  63. 490 PRINT "LATITUDE LONGITUDE MILES KILOMETERS BEARING"
  64. 491 PRINT "-------------------------------------------"
  65. 495 GOTO 475
  66. 500 REM 500 NUMBERED STATEMENTS READ THE FIRST SET OF DATA
  67. 502 REM WHICH CONTAINS THE US CITIES DATA AND PRINTS LIST
  68. 508 REM F IS A FLAG TO SEE IF BOTH CITIES & DX LIST ARE
  69. 509 REM DESIRED. IF YES ENTER AT 510 & F=1
  70. 510 LET F=1
  71. 514 REM 515 IS ENTRY POINT FOR CITIES ONLY (F=0 PRESET)
  72. 515 GOSUB 2000
  73. 520 PRINT "CITIES LISTING CENTERED ON";W$;" FOR ";N$
  74. 525 PRINT
  75. 530 PRINT "BEARINGS AND DISTANCES TO MAJOR US CITIES"
  76. 535 PRINT
  77. 540 PRINT TAB5;"CITY";TAB15;"LAT/LONG     MILES  K/M  BEARING"
  78. 545 PRINT"-------------------------------------------------"
  79. 550 LET K=K+1
  80. 559 REM READ DATA & CHECK FOR END OF FILE.
  81. 560 READ M$,B,L2
  82. 565 IF M$="ENDATA1" THEN 597
  83. 569 REM GO PERFORM THE CALCULATIONS
  84. 570 GOSUB 1000
  85. 575 PRINT M$;TAB13;B;"/";L2;TAB28;D1;TAB35;D2;TAB43;R2
  86. 580 IF K=55 THEN 590
  87. 585 GOTO 550
  88. 590 GOSUB 2000
  89. 595 GOTO 540
  90. 596 REM  IS FLAG SET FOR BOTH CITIES AND DX LIST?
  91. 597 IF F=1 THEN 614
  92. 598 RESTORE
  93. 599 GOTO 250
  94. 600 REM 600 NUMBERED STATEMENTS READ THE SECOND SET OF
  95. 602 REM DATA WHICH IS THE DX COUNTRIES LIST DATA.
  96. 603 REM 605 TO 610 FIND THE END OF THE FIRST DATA.
  97. 605 READ M$,B,L2
  98. 608 IF M$ = "ENDATA1" THEN 614
  99. 610 GOTO 605
  100. 614 GOSUB 2000
  101. 615 PRINT "BEARINGS TO DX LOCATIONS ON ARRL COUNTRIES LIST"
  102. 620 PRINT "DEL - MEANS A COUNTRY DELETED FROM ARRL LIST"
  103. 625 PRINT
  104. 630 PRINT "DX LISTING CENTERED FROM ";W$;" FOR ";N$
  105. 635 PRINT
  106. 640 PRINT TAB5;"DX PREFIC LAT/LONG   MILES  K/M  BEARING"
  107. 645 PRINT "----------------------------------------------"
  108. 650 LET K=K+1
  109. 655 LET J=J+1
  110. 660 READ M$,B,L2
  111. 665 IF M$="ENDATA2" THEN 696
  112. 670 GOSUB 1000
  113. 675 PRINT J;TAB5;M$;TAB15;B;"/";L2;TAB29;D1;TAB36;D2;TAB45;R2
  114. 680 IF K=55 THEN 690
  115. 685 GOTO 650
  116. 690 GOSUB 2000
  117. 695 GOTO 640
  118. 696 RESTORE
  119. 699 GOTO 250
  120. 700 REM THE 700 NUMBERED STATEMENTS MAKE UP THE ROUTINE TO
  121. 701 REM CALCULATE USER ENTERED COORDINATES ONE AT A TIME.
  122. 705 PRINT "ENTER DISTANT LOCATION DESIGNATION"
  123. 715 LINE INPUT M1$
  124. 720 PRINT
  125. 725 PRINT "ENTER LATITUDE OF DISTANT POINT."
  126. 735 INPUT B
  127. 740 PRINT
  128. 745 PRINT "ENTER LONGITUDE OF DISTANT POINT."
  129. 755 INPUT L2
  130. 760 GOSUB 1000
  131. 765 PRINT
  132. 770 PRINT "DISTANCE FROM ";W$;" TO ";M1$;" IS ";D1;" MILES."
  133. 771 PRINT "THAT DISTANCE IS ";D2;" KILOMETERS."
  134. 772 PRINT "BEARING TO ";M1$;" IS ";R2; "DEGREES."
  135. 775 PRINT
  136. 780 PRINT "DO YOU WANT OTHER POINTS CALCULATED? YES OR NO"
  137. 785 PRINT
  138. 790 INPUT T$
  139. 795 IF T$ = "YES" THEN 705
  140. 799 GOTO 250
  141. 1000 REM 1000 SERIES SUBROUTINE PERFORMS ALL CALCULATIONS.
  142. 1001 LET L=L2-L1
  143. 1002 REM - X IS A FLAG FOR TESTING L
  144. 1003 LET X=0
  145. 1005 REM BRING L WITHIN RANGE -180 TO 180
  146. 1010 IF L<-180 GOTO 1025
  147. 1015 IF L>180 GOTO 1035
  148. 1020 GOTO 1040
  149. 1025 LET L=L+360
  150. 1030 GOTO 1100
  151. 1035 LET L=L-360
  152. 1040 IF L<0 THEN 1100
  153. 1045 LET X=1
  154. 1100 REM CONVERT LAND B TO RADIANS
  155. 1110 LET B1=B*3.1415926#/180
  156. 1115 LET L=L*3.1415926#/180
  157. 1119 REM COMPUTE THE DISTANCE ANGLE
  158. 1120 LET P=COS(L)*COS(A1)*COS(B1)+SIN(A1)*SIN(B1)
  159. 1125 LET P1=ATN(SQR(1-P*P)/P)
  160. 1130 LET P2=P1*180/3.1415926#
  161. 1134 REM DISTANCE ANGLE MUST BE POSITIVE IF NOT ADD 180
  162. 1135 IF P2<0 GOTO 1145
  163. 1140 GOTO 1150
  164. 1145 LET P2=P2+180
  165. 1149 REM COMPUTE DISTANCE
  166. 1150 LET D1 = INT(P2*60*1.15152+.5)
  167. 1151 LET D2 = INT(D1*1.6093+.5)
  168. 1154 REM COMPUTE THE BEARING ANGLE.
  169. 1155 LET R=COS(B1)*SIN(L)/SIN(P1)
  170. 1160 LET R1=ATN(R/SQR(1-R*R))
  171. 1164 REM CONVERT BEARINGS TO DEGREES ROUNDED TO NEAREST INT
  172. 1165 LET R2=INT((R1*180/3.1415926#)+.5)
  173. 1168 REM DETERMINE WHAT QUADRANT THE BEARING ANGLE IS IN AND
  174. 1169 REM ADJUST THE DEGREES.
  175. 1170 IF ABS(R)>.999998 THEN 1500
  176. 1175 IF ABS(R)<.00174 THEN 1600
  177. 1180 LET B2=(B+.1)*3.1415926#/180
  178. 1185 LET R3=COS(L)*COS(A1)*COS(B2)+SIN(B2)*SIN(A1)
  179. 1190 LET R4=ATN(SQR(1-R3*R3)/R3)
  180. 1200 LET R6=COS(B2)*SIN(L)/SIN(R4)
  181. 1205 IF X=1 THEN 1240
  182. 1210 IF ABS(R6) >ABS(R) THEN 1230
  183. 1215 LET R2=360-ABS(R2)
  184. 1220 GOTO 1700
  185. 1230 LET R2=180+ABS(R2)
  186. 1235 GOTO 1700
  187. 1240 IF ABS(R6) < ABS(R) THEN 1255
  188. 1245 LET R2 = 180-ABS(R2)
  189. 1250 GOTO 1700
  190. 1255 LET R2 = ABS(R2)
  191. 1260 GOTO 1700
  192. 1500 IF X=1 THEN 1530
  193. 1510 LET R2=270
  194. 1520 GOTO 1700
  195. 1530 LET R2=90
  196. 1540 GOTO 1700
  197. 1600 IF ABS(L)>178 THEN 1640
  198. 1605 IF B<A THEN 1630
  199. 1610 LET R2=0
  200. 1620 GOTO 1700
  201. 1630 LET R2=180
  202. 1635 GOTO 1700
  203. 1640 IF B>A THEN 1630
  204. 1645 GOTO 1610
  205. 1700 RETURN
  206. 2000 REM THIS ROUTINE PRINTS BLANK LINES AFTER EVERY 55
  207. 2001 REM LINES OF DATA SO PAPER CAN BE CUT STANDARD SIZED.
  208. 2005 PRINT
  209. 2006 PRINT
  210. 2007 PRINT
  211. 2008 PRINT
  212. 2009 PRINT
  213. 2010 PRINT
  214. 2011 PRINT
  215. 2012 PRINT
  216. 2020 K=0
  217. 2030 RETURN
  218. -α/1 3@5`7Ç9á;└=α?A C@E`GÇIáK└MαOQ S@U`WÇYá[└]α_a c@e`gÇiák└mαoq s@u`wÇyá{└}αü â@à`çÇëáï└ìαÅ    æ     ô@    ò`    ùÇ    Öá    ¢└    ¥α    ƒ
  219. í 
  220. ú@
  221. Ñ`
  222. ºÇ
  223. ⌐á
  224. ½└
  225. ¡α
  226. »≡ ▒  │@ ╡` ╖Ç ╣á ╗└ ╜α ┐ ┴  ├@ ┼` ╟Ç ╔á ╦└ ═α ╧╤ ╙@╒`╫Ç┘á█└▌α▀ß π@σ`τÇΘáδ└φα∩± ≤≡ ⌡`≈Ç∙á√└²α !Aaü    í ┴ß!Aaüí┴ß /#A%a'ü)í+┴-ß/1!3A5a7ü9í;┴=ß?A± CAEaGüIíK┴MßOQ!SAUa